Trabalho final da disciplina

PROGRAMANDO IA COM R

Grupo2IA

July 3, 2018

Análise “Corridas de táxi de NY”

Alunos:

Nome RM
Augusto Cesar Ribeiro Freire 330695
Marcelo Muzilli 331136
Rafael da Silva Tomaz 330267
Renato Tavares da Silva 330659

Código Fonte

O código fonte do projeto está hospedado no Github no link:

Projeto Final taxi GitHub

Introdução

Será utilizado como base para as análises o documento: __“R__Trabalho_final_parte_1.pdf“__ com informações sobre as definições do projeto e o dataset “train.csv” fornecidos pelo professor, para o projeto através do portal do aluno.

O Dataset disponibilizado se refere a corridas de taxi de NYC, os campos do dataset:

Carregando variaveis e funçães necessrárias:

Para iniciar as análises será carregado algumas bibliotecas (pacotes) e dados de dependencias, conforme abaixo que se encontram no arquivo VariaveisGlobaisEFuncoesGlobais.R

# Carrega o arquivo necessarias em memória
source("VariaveisGlobaisEFuncoesGlobais.R")

# Instala pacotes adicionais e pacotes necessários
install_missing_packages()

# Faz o Load dos pacotes necessários para utilizar no projeto
load_packages()

# Faz Load dos arquivos necessários no projeto
load_file_dependenncies()

Dados do Dataset

  head(ds_taxi_train,5)
## # A tibble: 5 x 11
##   id    vendor_id pickup_datetime     dropoff_datetime    passenger_count
##   <chr>     <int> <dttm>              <dttm>                        <int>
## 1 id28…         2 2016-03-14 17:24:55 2016-03-14 17:32:30               1
## 2 id23…         1 2016-06-12 00:43:35 2016-06-12 00:54:38               1
## 3 id38…         2 2016-01-19 11:35:24 2016-01-19 12:10:48               1
## 4 id35…         2 2016-04-06 19:32:31 2016-04-06 19:39:40               1
## 5 id21…         2 2016-03-26 13:30:55 2016-03-26 13:38:10               1
## # ... with 6 more variables: pickup_longitude <dbl>,
## #   pickup_latitude <dbl>, dropoff_longitude <dbl>,
## #   dropoff_latitude <dbl>, store_and_fwd_flag <chr>, trip_duration <int>

Summary do Dataset

summary(ds_taxi_train) 
##       id              vendor_id     pickup_datetime              
##  Length:1458644     Min.   :1.000   Min.   :2016-01-01 00:00:17  
##  Class :character   1st Qu.:1.000   1st Qu.:2016-02-17 16:46:04  
##  Mode  :character   Median :2.000   Median :2016-04-01 17:19:40  
##                     Mean   :1.535   Mean   :2016-04-01 10:10:24  
##                     3rd Qu.:2.000   3rd Qu.:2016-05-15 03:56:08  
##                     Max.   :2.000   Max.   :2016-06-30 23:59:39  
##  dropoff_datetime              passenger_count pickup_longitude 
##  Min.   :2016-01-01 00:03:31   Min.   :0.000   Min.   :-121.93  
##  1st Qu.:2016-02-17 17:05:32   1st Qu.:1.000   1st Qu.: -73.99  
##  Median :2016-04-01 17:35:12   Median :1.000   Median : -73.98  
##  Mean   :2016-04-01 10:26:24   Mean   :1.665   Mean   : -73.97  
##  3rd Qu.:2016-05-15 04:10:51   3rd Qu.:2.000   3rd Qu.: -73.97  
##  Max.   :2016-07-01 23:02:03   Max.   :9.000   Max.   : -61.34  
##  pickup_latitude dropoff_longitude dropoff_latitude store_and_fwd_flag
##  Min.   :34.36   Min.   :-121.93   Min.   :32.18    Length:1458644    
##  1st Qu.:40.74   1st Qu.: -73.99   1st Qu.:40.74    Class :character  
##  Median :40.75   Median : -73.98   Median :40.75    Mode  :character  
##  Mean   :40.75   Mean   : -73.97   Mean   :40.75                      
##  3rd Qu.:40.77   3rd Qu.: -73.96   3rd Qu.:40.77                      
##  Max.   :51.88   Max.   : -61.34   Max.   :43.92                      
##  trip_duration    
##  Min.   :      1  
##  1st Qu.:    397  
##  Median :    662  
##  Mean   :    959  
##  3rd Qu.:   1075  
##  Max.   :3526282

Mapa de NYC (New York City)

Enriquecimento

Para enriquecimento do projeto conforme orientações definidas na Parte 1 (enriquecimento).

  data_wrangling_distance_calculate()
  data_wrangling_auxiliar_variables_definition()
  data_wrangling_quadrant_section_definition()

O Dataset será enriquecido com as seguintes variáveis: Diferença entre as duas métricas de distâncias Manhattan e Euclidiana

Enriquecimento (Continuação)

Para auxiliar nos gráficos será criado as variáveis:

Dados do Dataset após limpeza de dados

  head(ds_taxi_train,5)
## # A tibble: 5 x 28
##   id    vendor_id pickup_datetime     dropoff_datetime    passenger_count
##   <chr>     <int> <dttm>              <dttm>                        <int>
## 1 id28…         2 2016-03-14 17:24:55 2016-03-14 17:32:30               1
## 2 id23…         1 2016-06-12 00:43:35 2016-06-12 00:54:38               1
## 3 id38…         2 2016-01-19 11:35:24 2016-01-19 12:10:48               1
## 4 id35…         2 2016-04-06 19:32:31 2016-04-06 19:39:40               1
## 5 id21…         2 2016-03-26 13:30:55 2016-03-26 13:38:10               1
## # ... with 23 more variables: pickup_longitude <dbl>,
## #   pickup_latitude <dbl>, dropoff_longitude <dbl>,
## #   dropoff_latitude <dbl>, store_and_fwd_flag <chr>, trip_duration <int>,
## #   distancia.manhattan <dbl>, distancia.euclidiana <dbl>,
## #   distancia.manhattan.km <dbl>, distancia.manhattan.m <dbl>,
## #   distancia.euclidiana.km <dbl>, distancia.euclidiana.m <dbl>,
## #   trip_duration.minutes <int>, pickup_datetime.month <dbl>,
## #   pickup_datetime.day <int>, pickup_datetime.weekday <ord>,
## #   pickup_datetime.hour <int>, pickup_datetime.hour_period <dttm>,
## #   dropoff_datetime.month <dbl>, dropoff_datetime.day <int>,
## #   dropoff_datetime.weekday <ord>, dropoff_datetime.hour <int>,
## #   dropoff_datetime.day_period <dttm>

Summary do Dataset

  summary(ds_taxi_train) 
##       id              vendor_id     pickup_datetime              
##  Length:1458644     Min.   :1.000   Min.   :2016-01-01 00:00:17  
##  Class :character   1st Qu.:1.000   1st Qu.:2016-02-17 16:46:04  
##  Mode  :character   Median :2.000   Median :2016-04-01 17:19:40  
##                     Mean   :1.535   Mean   :2016-04-01 10:10:24  
##                     3rd Qu.:2.000   3rd Qu.:2016-05-15 03:56:08  
##                     Max.   :2.000   Max.   :2016-06-30 23:59:39  
##                                                                  
##  dropoff_datetime              passenger_count pickup_longitude 
##  Min.   :2016-01-01 00:03:31   Min.   :0.000   Min.   :-121.93  
##  1st Qu.:2016-02-17 17:05:32   1st Qu.:1.000   1st Qu.: -73.99  
##  Median :2016-04-01 17:35:12   Median :1.000   Median : -73.98  
##  Mean   :2016-04-01 10:26:24   Mean   :1.665   Mean   : -73.97  
##  3rd Qu.:2016-05-15 04:10:51   3rd Qu.:2.000   3rd Qu.: -73.97  
##  Max.   :2016-07-01 23:02:03   Max.   :9.000   Max.   : -61.34  
##                                                                 
##  pickup_latitude dropoff_longitude dropoff_latitude store_and_fwd_flag
##  Min.   :34.36   Min.   :-121.93   Min.   :32.18    Length:1458644    
##  1st Qu.:40.74   1st Qu.: -73.99   1st Qu.:40.74    Class :character  
##  Median :40.75   Median : -73.98   Median :40.75    Mode  :character  
##  Mean   :40.75   Mean   : -73.97   Mean   :40.75                      
##  3rd Qu.:40.77   3rd Qu.: -73.96   3rd Qu.:40.77                      
##  Max.   :51.88   Max.   : -61.34   Max.   :43.92                      
##                                                                       
##  trip_duration     distancia.manhattan distancia.euclidiana
##  Min.   :      1   Min.   : 0.00000    Min.   : 0.00000    
##  1st Qu.:    397   1st Qu.: 0.01123    1st Qu.: 0.01258    
##  Median :    662   Median : 0.02307    Median : 0.02122    
##  Mean   :    959   Mean   : 0.03603    Mean   : 0.03548    
##  3rd Qu.:   1075   3rd Qu.: 0.04585    3rd Qu.: 0.03841    
##  Max.   :3526282   Max.   :12.30804    Max.   :11.19260    
##                                                            
##  distancia.manhattan.km distancia.manhattan.m distancia.euclidiana.km
##  Min.   : 0.00000       Min.   :0.000e+00     Min.   : 0.00000       
##  1st Qu.: 0.01808       1st Qu.:1.808e-05     1st Qu.: 0.02025       
##  Median : 0.03713       Median :3.713e-05     Median : 0.03415       
##  Mean   : 0.05798       Mean   :5.798e-05     Mean   : 0.05710       
##  3rd Qu.: 0.07379       3rd Qu.:7.379e-05     3rd Qu.: 0.06181       
##  Max.   :19.80788       Max.   :1.981e-02     Max.   :18.01275       
##                                                                      
##  distancia.euclidiana.m trip_duration.minutes pickup_datetime.month
##  Min.   :0.000e+00      Min.   :    0.0       Min.   :1.000        
##  1st Qu.:2.025e-05      1st Qu.:    6.0       1st Qu.:2.000        
##  Median :3.414e-05      Median :   11.0       Median :4.000        
##  Mean   :5.710e-05      Mean   :   15.5       Mean   :3.517        
##  3rd Qu.:6.181e-05      3rd Qu.:   17.0       3rd Qu.:5.000        
##  Max.   :1.801e-02      Max.   :58771.0       Max.   :6.000        
##                                                                    
##  pickup_datetime.day  pickup_datetime.weekday pickup_datetime.hour
##  Min.   : 1.0        Domingo      :195366     Min.   : 0.00       
##  1st Qu.: 8.0        Segunda Feira:187418     1st Qu.: 9.00       
##  Median :15.0        Terca Feira  :202749     Median :14.00       
##  Mean   :15.5        Quarta Feira :210136     Mean   :13.61       
##  3rd Qu.:23.0        Quinta Feira :218574     3rd Qu.:19.00       
##  Max.   :31.0        Sexta Feira  :223533     Max.   :23.00       
##                      Sabado       :220868                         
##  pickup_datetime.hour_period   dropoff_datetime.month dropoff_datetime.day
##  Min.   :2016-01-01 00:00:17   Min.   :1.000          Min.   : 1.0        
##  1st Qu.:2016-02-17 16:46:04   1st Qu.:2.000          1st Qu.: 8.0        
##  Median :2016-04-01 17:19:40   Median :4.000          Median :15.0        
##  Mean   :2016-04-01 10:10:24   Mean   :3.517          Mean   :15.5        
##  3rd Qu.:2016-05-15 03:56:08   3rd Qu.:5.000          3rd Qu.:23.0        
##  Max.   :2016-06-30 23:59:39   Max.   :7.000          Max.   :31.0        
##                                                                           
##   dropoff_datetime.weekday dropoff_datetime.hour
##  Domingo      :197224      Min.   : 0.0         
##  Segunda Feira:187433      1st Qu.: 9.0         
##  Terca Feira  :202518      Median :14.0         
##  Quarta Feira :209790      Mean   :13.6         
##  Quinta Feira :217746      3rd Qu.:19.0         
##  Sexta Feira  :223031      Max.   :23.0         
##  Sabado       :220902                           
##  dropoff_datetime.day_period  
##  Min.   :2016-01-01 00:03:31  
##  1st Qu.:2016-02-17 17:05:32  
##  Median :2016-04-01 17:35:12  
##  Mean   :2016-04-01 10:26:24  
##  3rd Qu.:2016-05-15 04:10:51  
##  Max.   :2016-07-01 23:02:03  
## 

Análise básica de dados

Análise exploratória inicial:

Faça uma análise exploratória indicando:

Para melhorar a análise inicial, estamos avaliando o tempo de corridas com maior número e iremos remover as que tiverem as com menos tempo ou tempos muito grandes de corridas (outliers).

Variáveis do datase

  str(ds_taxi_train)
## Classes 'tbl_df', 'tbl' and 'data.frame':    1458644 obs. of  28 variables:
##  $ id                         : chr  "id2875421" "id2377394" "id3858529" "id3504673" ...
##  $ vendor_id                  : int  2 1 2 2 2 2 1 2 1 2 ...
##  $ pickup_datetime            : POSIXct, format: "2016-03-14 17:24:55" "2016-06-12 00:43:35" ...
##  $ dropoff_datetime           : POSIXct, format: "2016-03-14 17:32:30" "2016-06-12 00:54:38" ...
##  $ passenger_count            : int  1 1 1 1 1 6 4 1 1 1 ...
##  $ pickup_longitude           : num  -74 -74 -74 -74 -74 ...
##  $ pickup_latitude            : num  40.8 40.7 40.8 40.7 40.8 ...
##  $ dropoff_longitude          : num  -74 -74 -74 -74 -74 ...
##  $ dropoff_latitude           : num  40.8 40.7 40.7 40.7 40.8 ...
##  $ store_and_fwd_flag         : chr  "N" "N" "N" "N" ...
##  $ trip_duration              : int  455 663 2124 429 435 443 341 1551 255 1225 ...
##  $ distancia.manhattan        : num  0.0152 0.0265 0.0802 0.0155 0.0106 ...
##  $ distancia.euclidiana       : num  0.0177 0.0205 0.0599 0.0134 0.0107 ...
##  $ distancia.manhattan.km     : num  0.0244 0.0426 0.129 0.0249 0.017 ...
##  $ distancia.manhattan.m      : num  2.44e-05 4.26e-05 1.29e-04 2.49e-05 1.70e-05 ...
##  $ distancia.euclidiana.km    : num  0.0285 0.0329 0.0965 0.0216 0.0172 ...
##  $ distancia.euclidiana.m     : num  2.85e-05 3.29e-05 9.65e-05 2.16e-05 1.72e-05 ...
##  $ trip_duration.minutes      : int  7 11 35 7 7 7 5 25 4 20 ...
##  $ pickup_datetime.month      : num  3 6 1 4 3 1 6 5 5 3 ...
##  $ pickup_datetime.day        : int  14 12 19 6 26 30 17 21 27 10 ...
##  $ pickup_datetime.weekday    : Ord.factor w/ 7 levels "Domingo"<"Segunda Feira"<..: 2 1 3 4 7 7 6 7 6 5 ...
##  $ pickup_datetime.hour       : int  17 0 11 19 13 22 22 7 23 21 ...
##  $ pickup_datetime.hour_period: POSIXct, format: "2016-03-14 17:24:55" "2016-06-12 00:43:35" ...
##  $ dropoff_datetime.month     : num  3 6 1 4 3 1 6 5 5 3 ...
##  $ dropoff_datetime.day       : int  14 12 19 6 26 30 17 21 27 10 ...
##  $ dropoff_datetime.weekday   : Ord.factor w/ 7 levels "Domingo"<"Segunda Feira"<..: 2 1 3 4 7 7 6 7 6 5 ...
##  $ dropoff_datetime.hour      : int  17 0 12 19 13 22 22 8 23 22 ...
##  $ dropoff_datetime.day_period: POSIXct, format: "2016-03-14 17:32:30" "2016-06-12 00:54:38" ...

Summary do dataset por minutos de viagem

  # Gerando valores por minutos
  data <- 
    ds_taxi_train %>% 
      count(trip_duration.minutes , sort = TRUE)

  # Summary dos dados
  summary(data)
##  trip_duration.minutes       n        
##  Min.   :    0.0       Min.   :    1  
##  1st Qu.:  114.2       1st Qu.:    1  
##  Median :  474.0       Median :    2  
##  Mean   :  971.5       Mean   : 3185  
##  3rd Qu.: 1285.5       3rd Qu.:   32  
##  Max.   :58771.0       Max.   :89942

Gráfico de análise de viagens por minutos

  ggplot(aes(x=trip_duration.minutes, y=n ), data=data) +
    geom_line(alpha = 0.5, size = 1, position = 'jitter') +
    scale_x_continuous(limits = c(0.2, 20),
       breaks = c(1, 2, 3, 4, 5,6,7,8,9,10,11,12,13,14,15,20)) + 
    scale_y_continuous() +
    geom_smooth(method = "lm") +
    xlab("Minutos de tempo de corrida") +
    ylab("Quantidade de corridas") +
    ggtitle("Gráfico de duração de viagem de corridas pelo modelo linear")

Após analisar o gráfico acima, entendemos que o tempo com dados suficientes para análise com maior número de corridas estão com duração em minutos entre 4 e 13 minutos.

Subset

Filtrar o dataset para análise sobre um conjunto menor de dados, que contenha pelo menos 5000 observações.

Para a análise iremos utilizar apenas a região referênte a Manhattan, conforme o link wikipédia, em 2017 possui uma população de aproximadamente 1.664.727 habitantes, com uma área total de:

Os códigos de área desta região de New York possuem os formatos: 100xx, 101xx, 102xx.

## [1] "O Dataset original possui:  28  variáveis e  1458644  linhas"

Mapa da região a ser analisada

O Mapa da Região de Manhattan que serão utilizados na análise será conforme abaixo, com posicionamento central em (latitude 40.785091 e longitude -73.968285 ) como segue abaixo:

  # Gerando gráfico da regiao
  load_map_dependecy()

  # Imprimindo gráfico da região
  map

O Mapa acima possui longitudes entre (-74.07798 e -73.85825) e latitude entre (40.70172 e 40.86809), devido a isso, será considerado corridas que possuam inicio e fim dentro desses posicionamentos de longitude e latitude.

Dados da região analisada pelo mapa

  #Dados de longitude e latitude conforme definição
  map$data
##         lon      lat
## 1 -74.07798 40.70172
## 2 -73.85825 40.70172
## 3 -74.07798 40.86809
## 4 -73.85825 40.86809

Normalização dos dados do dataset para gerar o subset

Normalizando o Dataset para conter apenas os dados dentro dos limiares de longitude e latitude. Outra normalização que iremos realizar será de tempo de corrida, iremos utilizar para análise apenas corridas com tempo de duração maior ou igual 4 minutos e menor ou igual a 13 minutos.

  normalization_dataset_longitude_latitude_between_min_and_max()

  # Valor Em Minutos
  normalization_dataset_trip_duration_between_min_and_max(4, 13)
  
  # Validação dos dados do subset
  paste("Após a normalizaçãa de latitude e longitude e duração em minutos o Dataset possui: ", length(ds_taxi_train_subset),
        " variáveis e ", nrow(ds_taxi_train_subset), " linhas")
## [1] "Após a normalizaçãa de latitude e longitude e duração em minutos o Dataset possui:  28  variáveis e  759372  linhas"
  # Removendo variaveis:
  rm(ds_taxi_train)

Análises gráficas

Sumarização de contagem de corridas de Pickup e Dropoff por Mês

  # Gerando dados consolidados
  data <- 
    merge(
      ds_taxi_train_subset %>%  
        count(pickup_datetime.month , sort = TRUE) %>%
        rename(x_value = pickup_datetime.month, pickup_count = n) ,
      
      ds_taxi_train_subset %>% 
        count(dropoff_datetime.month , sort = TRUE) %>%
        rename(x_value = dropoff_datetime.month, dropoff_count = n)
      
      , by="x_value", all = TRUE
    )
  
  # Sumarização
  data_type <- 'Mês'
  summarise_by_data(data, data_type, 12)
##     x_value     pickup_count    dropoff_count   
##  Min.   :1.0   Min.   :117293   Min.   :    34  
##  1st Qu.:2.5   1st Qu.:124397   1st Qu.:120698  
##  Median :4.0   Median :126952   Median :125263  
##  Mean   :4.0   Mean   :126562   Mean   :108482  
##  3rd Qu.:5.5   3rd Qu.:128725   3rd Qu.:128692  
##  Max.   :7.0   Max.   :135315   Max.   :135296  
##                NA's   :1

Gráficos de corridas por período por mês

  #Gerando dados de labels
  y_lab <- 'Quantidade de corridas'
  x_lab <- data_type
  title <- 'Gráfico de linha temporal por mês'
  x_breaks <- seq(1,6,1)
  y_limits <- c(117000, 136000)
  y_breaks <- seq(117000, 136000, 2500)
  
  ploting_data(data, x_breaks,  y_limits, y_breaks, x_lab, y_lab, title)

Sumarização de contagem de corridas de Pickup e Dropoff por Período Semanal

  # Gerando dados consolidados
  data <- 
    merge(
      ds_taxi_train_subset %>%  
        count(pickup_datetime.weekday , sort = TRUE) %>%
        rename(x_value = pickup_datetime.weekday, pickup_count = n) ,
      
      ds_taxi_train_subset %>% 
        count(dropoff_datetime.weekday , sort = TRUE) %>%
        rename(x_value = dropoff_datetime.weekday, dropoff_count = n)
      
      , by="x_value", all = TRUE
    )
  
  # Sumarização
  data_type <- "Dia da semana"
  summarise_by_data(data, data_type, 12)
##           x_value   pickup_count    dropoff_count   
##  Domingo      :1   Min.   :100851   Min.   :100821  
##  Segunda Feira:1   1st Qu.:105232   1st Qu.:105140  
##  Terca Feira  :1   Median :107183   Median :107753  
##  Quarta Feira :1   Mean   :108482   Mean   :108482  
##  Quinta Feira :1   3rd Qu.:110959   3rd Qu.:110794  
##  Sexta Feira  :1   Max.   :118956   Max.   :118930  
##  Sabado       :1

Gráficos de corridas por dia da semana

  #Gerando dados de labels
  x_lab <- data_type
  y_lab <- 'Quantidade de corridas'
  title <- 'Gráfico de linha temporal por dia da Semana'
  y_limits <- c(100000, 120000)
  y_breaks <- seq(100000, 120000, 2500)
  
  ploting_data(data, NULL,  y_limits, y_breaks, x_lab, y_lab, title)

Gráfico consolidado

ggplot(data = data, aes(x=x_value,group = 1)) +
  geom_line(mapping = aes(y=pickup_count, color="Pick UP"), size=1) +
  geom_line(mapping = aes(y=dropoff_count, color="Drop Off"), size=1) +
  scale_color_manual(values = c(
    'Pick UP' = 'darkblue',
    'Drop Off' = 'red')) +
  labs(color = 'Labels') + 
  scale_y_continuous(limits = y_limits, breaks = y_breaks) + 
  geom_hline(yintercept = median(data$pickup_count), alpha=1, linetype=2) +
  geom_hline(yintercept = median(data$dropoff_count), alpha=1, linetype=2) +
  xlab(x_lab) +
  ylab(y_lab) +
  ggtitle(paste(title, " - Pickup e Dropoff"))

Sumarização de contagem de corridas de Pickup e Dropoff por dia do mês

  # Gerando dados consolidados
  data <- 
    merge(
      ds_taxi_train_subset %>%  
        count(pickup_datetime.day , sort = TRUE) %>%
        rename(x_value = pickup_datetime.day, pickup_count = n) ,
      
      ds_taxi_train_subset %>% 
        count(dropoff_datetime.day , sort = TRUE) %>%
        rename(x_value = dropoff_datetime.day, dropoff_count = n)
      
      , by="x_value", all = TRUE
    )
  
  # Sumarização
  data_type <- "Dia do Mês"
  summarise_by_data(data, data_type, 12)
##     x_value      pickup_count   dropoff_count  
##  Min.   : 1.0   Min.   :12021   Min.   :12038  
##  1st Qu.: 8.5   1st Qu.:24324   1st Qu.:24328  
##  Median :16.0   Median :25096   Median :25061  
##  Mean   :16.0   Mean   :24496   Mean   :24496  
##  3rd Qu.:23.5   3rd Qu.:25823   3rd Qu.:25843  
##  Max.   :31.0   Max.   :26584   Max.   :26544

Gráficos de corridas por período por dia do mês

  #Gerando dados de labels
  y_lab <- 'Quantidade de corridas'
  x_lab <- data_type
  title <- 'Gráfico de linha temporal por dia do mês'
  x_breaks <- seq(1,31,1)
  y_limits <- c(12000, 27000)
  y_breaks <- seq(12000, 27000, 1500)
  
  ploting_data(data, x_breaks,  y_limits, y_breaks, x_lab, y_lab, title)

Gráficos de corridas por período por dia do mês e por Mês

  # Gerando dados consolidados
  data <- 
    merge(
      ds_taxi_train_subset %>%  
        count(pickup_datetime.day, pickup_datetime.month , sort = TRUE) %>%
        rename(x_value = pickup_datetime.day, facet_wrap = pickup_datetime.month, pickup_count = n) ,
      
      ds_taxi_train_subset %>% 
        count(dropoff_datetime.day, dropoff_datetime.month, sort = TRUE) %>%
        rename(x_value = dropoff_datetime.day, facet_wrap = dropoff_datetime.month, dropoff_count = n) , 
      by=c("facet_wrap", "x_value"), all = TRUE
    )
  
  # Sumarização
  data_type <- "Dia do Mês e Mês"
  summarise_by_data(data, data_type, 10)
##    facet_wrap       x_value      pickup_count  dropoff_count 
##  Min.   :1.000   Min.   : 1.0   Min.   : 867   Min.   :  34  
##  1st Qu.:2.000   1st Qu.: 8.0   1st Qu.:3892   1st Qu.:3886  
##  Median :4.000   Median :16.0   Median :4198   Median :4180  
##  Mean   :3.519   Mean   :15.6   Mean   :4172   Mean   :4150  
##  3rd Qu.:5.000   3rd Qu.:23.0   3rd Qu.:4473   3rd Qu.:4470  
##  Max.   :7.000   Max.   :31.0   Max.   :5303   Max.   :5294  
##                                 NA's   :1

Gráficos de corridas por período por dia do mês

  #Gerando dados de labels
  y_lab <- 'Quantidade de corridas'
  x_lab <- data_type
  title <- 'Gráfico de linha temporal por dia do mês e Mês'
  x_breaks <- seq(1,31,2)
  y_limits <- c(0, 5300)
  y_breaks <- seq(0, 5300, 750)
  
  ploting_data(data, x_breaks,  y_limits, y_breaks, x_lab, y_lab, title, TRUE)

Gráficos de mapa de densidade

Clusterização (aprendizado não-supervisionado)

Nesse passo será criado uma coluna de categorização para Pickup, com os clusters encontrados.

  set.seed(20)
  
  clusters <- kmeans(ds_taxi_train_subset[,6:7], 5)
  
  #Salvar o numero do cluster na nova coluna -> 'category_pickup'
  ds_taxi_train_subset$category_pickup <- as.factor(clusters$cluster)
  str(clusters)
## List of 9
##  $ cluster     : int [1:759372] 2 5 3 1 5 2 4 1 4 5 ...
##  $ centers     : num [1:5, 1:2] -74 -74 -74 -74 -74 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : chr [1:5] "1" "2" "3" "4" ...
##   .. ..$ : chr [1:2] "pickup_longitude" "pickup_latitude"
##  $ totss       : num 589
##  $ withinss    : num [1:5] 69.5 29.2 13.9 12.5 13.5
##  $ tot.withinss: num 139
##  $ betweenss   : num 450
##  $ size        : int [1:5] 147196 238001 107947 148132 118096
##  $ iter        : int 7
##  $ ifault      : int 0
##  - attr(*, "class")= chr "kmeans"

Nesse passo será criado uma coluna de categorização para Dropoff, com os clusters encontrados.

  set.seed(20)
  
  clusters <- kmeans(ds_taxi_train_subset[,8:9], 5)
  
  #Salvar o numero do cluster na coluna -> 'category_dropoff'
  ds_taxi_train_subset$category_dropoff <- as.factor(clusters$cluster)
str(clusters)
## List of 9
##  $ cluster     : int [1:759372] 1 3 3 1 4 1 5 1 3 5 ...
##  $ centers     : num [1:5, 1:2] -74 -74 -74 -74 -74 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : chr [1:5] "1" "2" "3" "4" ...
##   .. ..$ : chr [1:2] "dropoff_longitude" "dropoff_latitude"
##  $ totss       : num 675
##  $ withinss    : num [1:5] 35.2 82.1 13.2 14 19.8
##  $ tot.withinss: num 164
##  $ betweenss   : num 511
##  $ size        : int [1:5] 242132 153865 97423 149444 116508
##  $ iter        : int 5
##  $ ifault      : int 0
##  - attr(*, "class")= chr "kmeans"

Mapa de Calor

##     X1    X2    X3    X4     X5     X6     X7     X8     X9     X10   
## Y10 "q10" "q46" "q82" "q118" "q154" "q190" "q226" "q262" "q298" "q334"
## Y9  "q9"  "q45" "q81" "q117" "q153" "q189" "q225" "q261" "q297" "q333"
## Y8  "q8"  "q44" "q80" "q116" "q152" "q188" "q224" "q260" "q296" "q332"
## Y7  "q7"  "q43" "q79" "q115" "q151" "q187" "q223" "q259" "q295" "q331"
## Y6  "q6"  "q42" "q78" "q114" "q150" "q186" "q222" "q258" "q294" "q330"
## Y5  "q5"  "q41" "q77" "q113" "q149" "q185" "q221" "q257" "q293" "q329"
## Y4  "q4"  "q40" "q76" "q112" "q148" "q184" "q220" "q256" "q292" "q328"
## Y3  "q3"  "q39" "q75" "q111" "q147" "q183" "q219" "q255" "q291" "q327"
## Y2  "q2"  "q38" "q74" "q110" "q146" "q182" "q218" "q254" "q290" "q326"
## Y1  "q1"  "q37" "q73" "q109" "q145" "q181" "q217" "q253" "q289" "q325"
##    names  x   y    x.from      x.to    y.from      y.to  x.center
## 1     q1 X1  Y1 -74.07798 -74.07198 -74.07798 -74.07198 -74.07498
## 2     q2 X1  Y2 -74.07798 -74.07198 -74.07198 -74.06598 -74.07498
## 3     q3 X1  Y3 -74.07798 -74.07198 -74.06598 -74.05998 -74.07498
## 4     q4 X1  Y4 -74.07798 -74.07198 -74.05998 -74.05398 -74.07498
## 5     q5 X1  Y5 -74.07798 -74.07198 -74.05398 -74.04798 -74.07498
## 6     q6 X1  Y6 -74.07798 -74.07198 -74.04798 -74.04198 -74.07498
## 7     q7 X1  Y7 -74.07798 -74.07198 -74.04198 -74.03598 -74.07498
## 8     q8 X1  Y8 -74.07798 -74.07198 -74.03598 -74.02998 -74.07498
## 9     q9 X1  Y9 -74.07798 -74.07198 -74.02998 -74.02398 -74.07498
## 10   q10 X1 Y10 -74.07798 -74.07198 -74.02398 -74.01798 -74.07498
## 11   q11 X1 Y11 -74.07798 -74.07198 -74.01798 -74.01198 -74.07498
## 12   q12 X1 Y12 -74.07798 -74.07198 -74.01198 -74.00598 -74.07498
## 13   q13 X1 Y13 -74.07798 -74.07198 -74.00598 -73.99998 -74.07498
## 14   q14 X1 Y14 -74.07798 -74.07198 -73.99998 -73.99398 -74.07498
## 15   q15 X1 Y15 -74.07798 -74.07198 -73.99398 -73.98798 -74.07498
## 16   q16 X1 Y16 -74.07798 -74.07198 -73.98798 -73.98198 -74.07498
## 17   q17 X1 Y17 -74.07798 -74.07198 -73.98198 -73.97598 -74.07498
## 18   q18 X1 Y18 -74.07798 -74.07198 -73.97598 -73.96998 -74.07498
## 19   q19 X1 Y19 -74.07798 -74.07198 -73.96998 -73.96398 -74.07498
## 20   q20 X1 Y20 -74.07798 -74.07198 -73.96398 -73.95798 -74.07498
## 21   q21 X1 Y21 -74.07798 -74.07198 -73.95798 -73.95198 -74.07498
## 22   q22 X1 Y22 -74.07798 -74.07198 -73.95198 -73.94598 -74.07498
## 23   q23 X1 Y23 -74.07798 -74.07198 -73.94598 -73.93998 -74.07498
## 24   q24 X1 Y24 -74.07798 -74.07198 -73.93998 -73.93398 -74.07498
## 25   q25 X1 Y25 -74.07798 -74.07198 -73.93398 -73.92798 -74.07498
## 26   q26 X1 Y26 -74.07798 -74.07198 -73.92798 -73.92198 -74.07498
## 27   q27 X1 Y27 -74.07798 -74.07198 -73.92198 -73.91598 -74.07498
## 28   q28 X1 Y28 -74.07798 -74.07198 -73.91598 -73.90998 -74.07498
## 29   q29 X1 Y29 -74.07798 -74.07198 -73.90998 -73.90398 -74.07498
## 30   q30 X1 Y30 -74.07798 -74.07198 -73.90398 -73.89798 -74.07498
## 31   q31 X1 Y31 -74.07798 -74.07198 -73.89798 -73.89198 -74.07498
##     y.center
## 1  -74.07498
## 2  -74.06898
## 3  -74.06298
## 4  -74.05698
## 5  -74.05098
## 6  -74.04498
## 7  -74.03898
## 8  -74.03298
## 9  -74.02698
## 10 -74.02098
## 11 -74.01498
## 12 -74.00898
## 13 -74.00298
## 14 -73.99698
## 15 -73.99098
## 16 -73.98498
## 17 -73.97898
## 18 -73.97298
## 19 -73.96698
## 20 -73.96098
## 21 -73.95498
## 22 -73.94898
## 23 -73.94298
## 24 -73.93698
## 25 -73.93098
## 26 -73.92498
## 27 -73.91898
## 28 -73.91298
## 29 -73.90698
## 30 -73.90098
## 31 -73.89498

Modelagem ML

Foi utilizado tecnicas de noramlização de dados e limpeza de dados para criação de novas variáveis para adequar os dados para utilizar no modelo.

Para o modelo iremos utilizar 70% dos dados para treinamento e 30% dos dados para teste:

os dados utilizados para modelagem da predição serão

Dados de entradas (Feature Engineering) Pickups (longitude, latitude) Dropoff (longitude, latitude) week_day period_of_day (manha_tarde_noite)

Processamento: Algoritmo PCA com regressão linear

Dados de saída(s) Tempo de corrida Distância

Definir processamento Avaliação Matriz de confusão (por Acurácia)

Modelo Predicao

Conclusão

Este projeto foi fundamental para colocar em prática diversos conceitos aprendidos em aula e em pesquisas realizadas durante o curso e durante o trabalho.

Dessa forma realizamos limpeza de dados e tratamento de dados para facilitar o início do tratalho, utilizando estratégia de programação funcional, reaproveitando códgio e utilizando APIs como Dplyr para facilitar na manipulação e criação de variáveis, utilizamos lubridate para tratamento de varíaveis de tempo como data e hora das corridas para descobrir o dia da semana.

Utilizamos conceitos estatísticos para realizar análise de dados e entendimento das corridas e do comportamento das corridas do de manhattan em NYC.

Utilizamos gráficos com ggplot, plot e plotly para melhor visualizar os dados das corridas para melhor entender os horários de corrídas.

E entendimento de algorítimos de de predição e de normalização de dados pararealizar análises preditivas.

Obrigado